home *** CD-ROM | disk | FTP | other *** search
/ Disc to the Future 2 / Disc to the Future Part II Programmer's Reference (Wayzata Technology)(6013)(1992).bin / MAC / YERK / SUPPLEME / UNSUPPOR / OPTIONAL / LINKEDLI.ST < prev    next >
Text File  |  1986-02-06  |  7KB  |  283 lines
  1. \ This file contains classes to support the data structures: queues and
  2. \  linked lists.
  3. \ 11/12/84  rw
  4. \ 12/26/85  rfd Added stack notation
  5. \               Incramented size by 1 in SetData
  6. \ 12/27/85  rfd Print routine traverses links
  7. \               Modified after:
  8. \ 12/30/85  rfd Modified delete: & size:
  9. \ 1/16/86   rfd Change EOLL from -1 to -FFFF
  10. \               Mdified AFTER, BEFORE, PRINT, CREATE, SETDATA
  11.  
  12.  
  13.  
  14. :CLASS LinkArray     <Super Object     8 <Indexed
  15.  
  16.     \ ( n -- nextval )
  17.        :M  NEXT:         ^elem w@       ;M
  18.  
  19.     \ ( n -- prevval )
  20.        :M  PREV:   ^elem 2+ w@    ;M
  21.  
  22.     \    ( n -- data )
  23.        :M GETDATA:    ^elem 4+ @     ;M
  24.  
  25.     \    ( nextval n -- )
  26.        :M SETNEXT:    ^elem w!       ;M
  27.  
  28.     \ ( prev index -- )
  29.        :M SETPREV:    ^elem 2+ w!    ;M
  30.  
  31.     \ ( data index -- )
  32.        :M SETDATA:        ^elem 4+ !     ;M
  33.  
  34. ;CLASS
  35.  
  36.  
  37. \ LinkedList - The usual gimmickry. Should have all the operations
  38. \  anyone could ever want. Note though that it is implemented as a
  39. \  circular linked list, for full generality. To treat it as a circular
  40. \  linked list though, use the subclass CircleList.
  41.     hex -FFFF Constant EOLL    decimal    ( End Of LinkedList indicator    )
  42.     22 Constant FRONTconst
  43.     39 Constant BACKconst
  44. :CLASS LinkedList     <Super Object
  45.  
  46.        Int     Front
  47.        Int     Back
  48.        Int     Current
  49.        Int     Size
  50.     var poolsize
  51.     var    thePool
  52.     var    FreeListHead
  53.  
  54.     \    ( -- data )
  55.        :M  GetData:
  56.         get: size 0=
  57.         IF 
  58.             EOLL
  59.         ELSE
  60.                   get: current GetData: [ get: thePool ]
  61.         THEN
  62.        ;M
  63.     
  64.     \    ( data -- )
  65.        :M  SetData:
  66.               get: size 0 =
  67.         IF 1 put: size
  68.         THEN
  69.         get: current SetData: [ get: thePool ]
  70.         depth 0 do drop loop
  71.     ;M
  72.     
  73.     \    ( idx -- )
  74.        :M  AddFree:
  75.               get: FreeListHead -1 = 
  76.               IF                ( nothing in FreeList )
  77.                      dup put: FreeListHead
  78.                      -1 swap setNext: [ get: thePool ]
  79.               ELSE
  80.                      dup get: FreeListHead swap SetNext: [ get: thePool ]
  81.                      put: FreeListHead
  82.               THEN
  83.        ;M
  84.     
  85.     \    ( -- idx )
  86.        :M  GetFree:
  87.               get: FreeListHead -1 =
  88.               IF                ( nothing in FreeList )
  89.                      ( get more Pool )
  90.                      classerr" 157
  91.               ELSE
  92.                      get: FreeListHead next: [ get: thePool ] -1 =
  93.                      IF            ( one thing in FreeList )
  94.                             get: FreeListHead 
  95.                 -1 Put: FreeListHead
  96.                 1 +: size
  97.                      ELSE            ( Many Things in FreeList )
  98.                  get: FreeListHead
  99.                             dup next: [ get: thePool ]
  100.                             put: FreeListHead
  101.                 1 +: size
  102.                      THEN
  103.               THEN
  104.        ;M
  105.     
  106.     \    ( -- current )
  107.        :M  GetCurrent:
  108.               get: current
  109.        ;M
  110.     
  111.     \    ( current -- )
  112.        :M SetCurrent:
  113.               put: current
  114.        ;M
  115.     
  116.     \    ( -- data )
  117.        :M  Next:
  118.               get: current get: back = get: size 0= or
  119.               IF
  120.                      EOLL
  121.               ELSE
  122.                      get: current next: [ get: thePool ] dup
  123.                      put: current
  124.                      getData: [ get: thePool ]
  125.               THEN
  126.        ;M
  127.     
  128.     \    ( -- data )
  129.        :M  Prev:
  130.               get: current get: front = get: size 0= or
  131.               IF
  132.                      EOLL
  133.               ELSE
  134.                      get: current prev: [ get: thePool ] dup
  135.                      put: current
  136.                      getData: [ get: thePool ]
  137.               THEN
  138.        ;M
  139.     
  140.     \    ( -- data )
  141.        :M  Front:
  142.               get: size 0=
  143.               IF
  144.                      EOLL
  145.               ELSE
  146.                      get: front dup put: Current
  147.                      getData: [ get: thePool ]
  148.               THEN
  149.        ;M 
  150.     
  151.     \    ( data -- )
  152.        :M  Before:
  153.         get: poolsize get: size = 
  154.         IF
  155.             ." linked list full not added " drop
  156.         ELSE            
  157.             GetFree: self
  158.                   Get: current prev: [ get: thePool ]    ( data new new prev -- )
  159.             2dup swap SetPrev: [ get: thePool ] drop 
  160.                   Get: current         ( data new new current -- )
  161.                   2dup SetPrev: [ get: thePool ]
  162.                   2dup swap SetNext: [ get: thePool ]
  163.                   get: front = 
  164.             IF 
  165.                 dup put: front
  166.             ELSE
  167.                 dup dup prev: [ get: thePool ]
  168.                     SetNext: [ get: thePool ]
  169.             THEN
  170.                   dup put: current
  171.                   SetData: [ get: thePool ]
  172.         THEN
  173.        ;M
  174.  
  175.     \    ( data -- )
  176.        :M  Create: { \ curr data new -- }
  177.            -> data
  178.         get: current -> curr 
  179.  
  180.         getFree: self -> new ( data new )
  181.            EOLL new setNext: [ get: thePool ]    ( data new )
  182.            curr new setPrev: [ get: thePool ]    ( data new )
  183.            new curr setnext: [ get: thepool ]
  184.         new put: back        ( data new ) 
  185.            new put: current    ( data new ) 
  186.            data setdata: self
  187.  
  188.        ;M
  189.     
  190.     \    ( data -- )
  191.        :M  After:
  192.         get: poolsize get: size = 
  193.         IF
  194.             ." linked list full not added " drop
  195.         ELSE           
  196.             get: current
  197.             next: self  prev: self drop EOLL = ( data new new next -- )
  198.                IF
  199.                put: current
  200.                Create: self 
  201.                ELSE
  202.                 drop getfree: self  
  203.                 getcurrent: self 
  204.                 2dup swap 
  205.                 setPrev: [ get: thePool ] 
  206.                 2dup next: [ get: thePool ]   
  207.                 2dup swap setnext: [ get: thePool ]
  208.                 setprev: [ get: thepool ] 
  209.                 2dup setnext: [ get: thepool ] drop 
  210.                 dup put: current 
  211.                 setdata: [ get: thepool ]
  212.             THEN
  213.         THEN
  214.        ;M
  215.     
  216.        :M  Delete:
  217.               get: size 0 = abort" LinkedList is Empty "
  218.               get: size 1 - put: size
  219.               get: current prev: [ get: thePool ]     ( prev -- )
  220.               get: current next: [ get: thePool ]        ( prev next -- )
  221.            next: self prev: self drop EOLL =
  222.         IF
  223.         ELSE
  224.                2dup SetPrev: [ get: thePool ]
  225.         THEN
  226.               swap setNext: [ get: thePool ]
  227.            FRONTconst
  228.               get: current get: back = 
  229.               IF
  230.             drop BACKconst get: current prev: [ get: thePool ]
  231.             put: back 
  232.         THEN
  233.               get: current get: front =
  234.               IF 
  235.             get: current next: [ get: thePool ]
  236.             put: front 
  237.         THEN
  238.               FRONTconst =
  239.         IF
  240.                      get: current dup next: [ get: thePool ] 
  241.             put: current
  242.               ELSE
  243.                      get: current dup prev: [ get: thePool ]
  244.             put: current
  245.               THEN
  246.               ( old current is on stack )
  247.               addFree: self
  248.        ;M
  249.  
  250.        :M  Size:   get: size ;M
  251.       
  252.     \ ( maxindx -- )
  253.        :M Classinit:   1 put: size 
  254.            put: poolsize
  255.            get: poolsize Heap> linkArray put: thePool
  256.            EOLL get: FreeListHead setNext: [ get: thePool ]
  257.            get: poolsize 1 
  258.                   DO
  259.                          get: FreeListHead i setNext: [ get: thePool ]
  260.                          i put: freeListHead
  261.                LOOP
  262.             0 setcurrent: self EOLL setdata: self 0 put: size 
  263.      ;M
  264.  
  265.        :M  Print:
  266.         size: self 0 = 
  267.         IF ." list empty "
  268.         ELSE
  269.             front: self
  270.             getcurrent: self . . cr
  271.             BEGIN
  272.                 next: self
  273.                 dup EOLL =
  274.                 IF drop 1
  275.                 ELSE getcurrent: self . . cr 0
  276.                 THEN
  277.             UNTIL 
  278.         THEN
  279.         front: self drop
  280.     ;M
  281.  
  282. ;CLASS
  283.